home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 20
/
Cream of the Crop 20 (Terry Blount) (1996).iso
/
os2
/
ftree10f.zip
/
ExGedcom.ftx
< prev
next >
Wrap
Text File
|
1996-05-25
|
6KB
|
223 lines
/*
Family Tree Rexx Script FTX
Copyright (C) 1996 by <Nils Meier>
Please send comments to / Kommentar bitte an
meier2@athene.informatik.uni-bonn.de
<This script exports the family tree to a GEDCOM file
/ Dieses Skript exportiert den Stammbaum in eine GEDCOM Datei.>
*/
CALL RxFuncAdd 'SysFileDelete', 'RexxUtil', 'SysFileDelete'
/* ----------------------- Params / Parameter ------------------- */
namewidth=30
datasex = ' MW'
datamonth = 'JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC'
IF getLanguage()='Deutsch' THEN DO
header = 'Exportiere nach GEDCOM:'
select = 'GEDCOM-Export-Datei angeben:'
fileerror = 'Fehler waehrend des Schreibens von : '
exporthead = 'Exportiere HEAD ...'
exportindis= 'Exportiere INDIs ...'
exportfams = 'Exportiere FAMs ...'
done = 'Fertig !'
END
ELSE DO
header = 'Exporting to GEDCOM:'
select = 'Select GEDCOM file for export:'
fileerror = 'Error during writing to : '
exporthead = 'Exporting HEAD ...'
exportindis= 'Exporting INDIs ...'
exportfams = 'Exporting FAMs ...'
done = 'Done !'
END
/* ----------------- Display Header / Kopf der Ausgabe ------------- */
SAY(header||DATE())
SAY('.............................................')
/* ------------------- Open file / Datei oeffnen ---------------- */
filename=getFileName(select,'*.GED')
IF filename='' THEN DO
SAY(done)
RETURN
END
rc=SysFileDelete(filename)
rc=rc+LINEOUT(filename,,1)
IF (rc=1) THEN DO
SAY(fileerror||filename)
RETURN
END
/* -------------- Header of GEDCOM / Kopf von GEDCOM -------------- */
SAY(exporthead)
rc=LINEOUT(filename,'0 HEAD')
rc=LINEOUT(filename,'1 SOUR FamilyTree for OS/2 - ExGedcom.ftx')
rc=LINEOUT(filename,'2 VERS 1.0f')
rc=LINEOUT(filename,'1 CHAR IBMPC')
rc=LINEOUT(filename,'1 FILE '||FILESPEC('name',filename))
rc=LINEOUT(filename,'1 DATE '||DATE())
/* ------------ Export Persons / Personen exportieren -------------- */
SAY(exportindis)
rc=selectPerson('F')
DO WHILE RC=1
/* Personal Data / persoenliche Daten */
rc=LINEOUT(filename,'0 @I'||getPID()||'@ INDI')
rc=LINEOUT(filename,'1 NAME '||getFirstName()||' /'||getName()||'/')
rc=LINEOUT(filename,'1 SEX '||SUBSTR(datasex,getSex()+1,1))
rc=LINEOUT(filename,'1 BIRT')
rc=LINEOUT(filename,'2 DATE '||calcDate(getBirthDate('D'),getBirthDate('M'),getBirthDate('Y')))
rc=LINEOUT(filename,'2 PLAC '||getBirthPlace())
rc=LINEOUT(filename,'1 DEAT')
rc=LINEOUT(filename,'2 DATE '||calcDate(getDeathDate('D'),getDeathDate('M'),getDeathDate('Y')))
rc=LINEOUT(filename,'2 PLAC '||getDeathPlace())
temp=getPicture()
IF temp<>'' THEN
rc=LINEOUT(filename,'1 PHOT '||temp)
temp=getOccupation()
IF temp<>'' THEN
rc=LINEOUT(filename,'1 OCCU '||temp)
temp=getAddress()
tag='1 ADDR '
DO WHILE temp<>''
p=POS(',',temp)
IF p=0 THEN p=LENGTH(temp)+1
rc=LINEOUT(filename,tag||SUBSTR(temp,1,p-1))
temp=SUBSTR(temp,p+1)
tag='2 CONT '
END
l=1
tag='1 NOTE '
DO FOREVER
temp=getMemo(l)
IF LENGTH(temp)=0 THEN LEAVE
rc=LINEOUT(filename,tag||temp)
tag='2 CONT '
l=l+1
END
/* Families with partners / Familien mit Partnern */
f=1
DO FOREVER
rc=selectFamily(f)
IF rc=0 THEN LEAVE
rc=LINEOUT(filename,'1 FAMS @F'||getFID()||'@')
f=f+1
END
/* Family of parents / Familie der Eltern */
rc=selectFamily('p')
IF rc=1 THEN
rc=LINEOUT(filename,'1 FAMC @F'||getFID()||'@')
/* Next one / Naechster */
rc=selectPerson('N')
END
/* ------------ Export Families / Familien exportieren -------------- */
SAY(exportfams)
rc=selectFamily('F')
DO WHILE RC=1
/* Standard data / Standarddaten */
rc=LINEOUT(filename,'0 @F'||getFID()||'@ FAM')
rc=selectPerson('f')
rc=LINEOUT(filename,'1 HUSB '||'@I'||getPID()||'@')
rc=selectPerson('m')
rc=LINEOUT(filename,'1 WIFE '||'@I'||getPID()||'@')
rc=LINEOUT(filename,'1 MARR')
rc=LINEOUT(filename,'2 DATE '||calcDate(getMarriageDate('D'),getMarriageDate('M'),getMarriageDate('Y')))
rc=LINEOUT(filename,'2 PLAC '||getMarriagePlace())
rc=LINEOUT(filename,'1 DIV')
rc=LINEOUT(filename,'2 DATE '||calcDate(getDivorceDate('D'),getDivorceDate('M'),getDivorceDate('Y')))
/* Children / Kinder */
c=1
DO FOREVER
rc=selectPerson(c)
IF rc=0 THEN LEAVE
rc=LINEOUT(filename,'1 CHIL @I'||getPID()||'@')
c=c+1
END
/* Next one / Naechster */
rc=selectFamily('N')
END
/* ------------------- Close File / Datei schliessen -------------- */
rc=LINEOUT(filename,'0 TRLR')
rc=LINEOUT(filename)
/* ------------------------ Done / Fertig ---------------------------*/
SAY(done)
RETURN
/* =============== Auxilary Functions / Hilfsfunktionen =============== */
/* --------------- Calculate Date / Datum berechnen ---------------- */
calcDate:
day=ARG(1)
month=ARG(2)
year=ARG(3)
/* --- dd.mm.yyyy -> 'dd mm yyyy' ---- */
IF (day>0)&(month>0)&(year>0) THEN
RETURN(day||' '||month||' '||year)
/* --- ??.??.???? -> '' -------------- */
IF (day=0)&(month=0)&(year=0) THEN
RETURN('')
/* --- ??.mm.yyyy -> 'MMM yyyy ------- */
IF (day=0)&(month>0)&(year>0) THEN
RETURN(WORD(datamonth,month)||' '||year)
/* --- ??.??.yyyy -> 'yyyy' ---------- */
IF (day=0)&(month=0)&(year>0) THEN
RETURN(year)
/* --- dd.mm.???? -> 'dd MMM' -------- */
IF (day>0)&(month>0)&(year=0) THEN
RETURN(day||' '||WORD(datamonth,month))
/* --- ??.mm.???? -> 'MMM' ----------- */
IF (day=0)&(month>0)&(year=0) THEN
RETURN(WORD(datamonth,month))
/* --- dd.??.yyyy -> 'yyyy' ---------- */
IF (day>0)&(month=0)&(year>0) THEN
RETURN(year)
/* --- dd.??.???? -> ''--------------- */
RETURN('')